home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / language / xlisp_21.zoo / xl-cl001.fix < prev    next >
Internet Message Format  |  1990-02-28  |  41KB
  1. From sce!mitel!uunet!zephyr.ens.tek.com!tekcrl!tekgvs!toma Sat Sep 16 08:20:18 EDT 1989
  2. Article: 1 of comp.lang.lisp.x
  3. Path: cognos!sce!mitel!uunet!zephyr.ens.tek.com!tekcrl!tekgvs!toma
  4. From: toma@tekgvs.LABS.TEK.COM (Tom Almy)
  5. Newsgroups: comp.lang.lisp.x
  6. Subject: XLISP 2.0 BUG(?)
  7. Message-ID: <5911@tekgvs.LABS.TEK.COM>
  8. Date: 11 Sep 89 14:34:11 GMT
  9. Reply-To: toma@tekgvs.LABS.TEK.COM (Tom Almy)
  10. Organization: Tektronix, Inc., Beaverton,  OR.
  11. Lines: 22
  12.  
  13.  
  14. Part of my effort to make xlisp more compatible with Common Lisp:
  15.  
  16. Problem: Functions which take the :end keyword argument do not allow NIL
  17.     to mean "end of list" as in Common Lisp.
  18.  
  19. Example: (string-downcase "ABC DEF" :start 4 :end NIL) gives an error.
  20.  
  21. Fix: in function getbounds() in file xlstr.c, change
  22.  
  23.     if (xlgkfixnum(ekey,&arg)) {
  24.         *pend = (int)getfixnum(arg);
  25.  
  26. to
  27.     if (xlgetkeyarg(ekey, &arg) && arg != NIL) {
  28.         if (!fixp(arg)) xlbadtype(arg);
  29.         *pend = (int)getfixnum(arg);
  30.  
  31.  
  32. Tom Almy
  33. toma@tekgvs.labs.tek.com
  34. Standard Disclaimers Apply
  35.  
  36.  
  37. From sce!mitel!uunet!zephyr.ens.tek.com!tekcrl!tekgvs!toma Sat Sep 16 08:20:26 EDT 1989
  38. Article: 2 of comp.lang.lisp.x
  39. Path: cognos!sce!mitel!uunet!zephyr.ens.tek.com!tekcrl!tekgvs!toma
  40. From: toma@tekgvs.LABS.TEK.COM (Tom Almy)
  41. Newsgroups: comp.lang.lisp.x
  42. Subject: XLISP 2.0 Modifications (1 of 2)
  43. Message-ID: <5918@tekgvs.LABS.TEK.COM>
  44. Date: 11 Sep 89 22:25:11 GMT
  45. Reply-To: toma@tekgvs.LABS.TEK.COM (Tom Almy)
  46. Organization: Tektronix, Inc., Beaverton,  OR.
  47. Lines: 393
  48.  
  49. I have recently been adding a few Common Lisp functions to XLISP 2.0, and
  50. makeing some existing functions more Common-Lisp compatible (particularly
  51. in making functions that are supposed to take sequence arguments (in XLISP
  52. that would be lists, arrays, or strings) actually take them.
  53.  
  54. These changes produce the following consequences:
  55.  
  56. 1.  Functions with names starting with "STRING" will accept a symbol as
  57.     the string argument.  The symbols printname string is used.
  58.  
  59. 2.  STRCAT is eliminated (a macro is placed in init.lsp for backwards
  60.     compatibility).  The replacement function is CONCATENATE which will
  61.     concatenate sequences of any type(s) into a result sequence of any
  62.     type.  It is used: (CONCATENATE <type> <seq1> [<seq2> ...]) where 
  63.     type is the result type, one of CONS ARRAY or STRING.
  64.  
  65. 3.  AREF will work on strings as well as arrays.
  66.  
  67. 4.  SUBSEQ REVERSE REMOVE... DELETE... take sequence arguments rather 
  68.     than just list arguments.
  69.  
  70. 5.  REMOVE... and DELETE... accept :start and :end keyword arguments.
  71.  
  72. 6.  Added function (ELT <seq> <index>) which combines the functionality
  73.     of AREF and NTH.
  74.  
  75. 7.  Added function (MAP <type> <fcn> <seq1> [<seq2> ...]) a mapping
  76.     function over sequences.  The resulting sequence is of type <type>,
  77.     which is one of CONS ARRAY STRING or NIL (meaning no, or NIL, result).
  78.  
  79. 8.  Added functions POSITION-IF, FIND-IF, and COUNT-IF, which work
  80.     analogously to REMOVE-IF, but return the position of the first match,
  81.     the first match, and number of matches, respectively.
  82.  
  83. 9.  Added function (SEARCH <seq1> <seq2> &key :test :test-not :start1
  84.     :end1 :start2 :end2) which returns the index of the first occurance
  85.     of seq1 in seq2. For example (search #(a b c) '(a b a b c d)) returns
  86.     2.
  87.  
  88. 10. Added function (COERCE <expr> <type>) which can coerce between 
  89.     sequence types and in a limited basis to characters or floating point
  90.     numbers.
  91.  
  92.  
  93. This is the first of two parts.  The final line in this file is "This is
  94. the end of part 1."
  95.  
  96.  
  97. Tom Almy
  98. September 11, 1989
  99. toma@tekgvs.labs.tek.com
  100. Standard Disclaimers Apply
  101.  
  102.  
  103. ***************************************
  104. The first change reduces the amount of code.
  105.  
  106. In xlsubr.c, add the following definition:
  107.  
  108. /* xlbadtype - report a "bad argument type" error */
  109. LVAL xlbadtype(arg)
  110.   LVAL arg;
  111. {
  112.     return xlerror("bad argument type",arg);
  113. }
  114.  
  115.  
  116. Then replace all occurances of `xlerror("bad argument type",' with
  117. `xlbadtype(' throughout the program (including xlisp.h).
  118.  
  119. ***************************************
  120.  
  121. Add the file xlseq.c to your "makefile" in an appropriate manner.
  122.  
  123. ***************************************
  124. Add definition in xlisp.h:
  125.  
  126. #define xlgastrorsym()  (testarg(symbolp(*xlargv) ? getpname(nextarg()) : typearg(stringp)))
  127.  
  128. Added external declaration in xlisp.h:
  129. extern LVAL xlbadtype();        /* report "bad argument type" error */
  130.  
  131.  
  132.  
  133. ***************************************
  134. Add to init.lsp:
  135. (unless (fboundp 'strcat) ; backwards compatibility 
  136.     (defmacro strcat (&rest str) `(concatenate 'string ,@str)))
  137.  
  138.  
  139.  
  140. ***************************************
  141. In xlftab.c, add the following external declaration:
  142. extern LVAL
  143.     xcoerce(), xconcatenate(), xelt(), xmap(), xsearch(), xpositionif(),
  144.     xcountif(),xfindif();
  145.  
  146. delete the declaration for xstrcat.
  147.  
  148. In funtab[], replace the definition for STRCAT with:
  149.  
  150. {   "CONCATENATE",      S, xconcatenate }, /* 168 */
  151.  
  152. Replace NULL definitions at the end of the table with new definitions,
  153. being sure to keep the table length constant.
  154.  
  155. {   "COUNT-IF",         S, xcountif     }, /* 287 */
  156. {   "FIND-IF",          S, xfindif      }, /* 288 */
  157. {   "COERCE",           S, xcoerce      }, /* 289 */
  158. {   "ELT",              S, xelt         }, /* 290 */
  159. {   "MAP",              S, xmap         }, /* 291 */
  160. {   "POSITION-IF",      S, xpositionif  }, /* 292 */
  161. {   "SEARCH",           S, xsearch      }, /* 293 */
  162.  
  163. *******************************
  164.  
  165. In file xlglob.c, add the following definition:
  166.  
  167. LVAL s_elt = NIL;
  168.  
  169. *******************************
  170.  
  171. In file xlinit.c, add the following external declaration:
  172.  
  173. extern LVAL s_elt;
  174.  
  175. in function xlsymbols(), in section "enter setf place specifiers", add
  176.  
  177.     s_elt   = xlenter("ELT");
  178.  
  179. *******************************
  180.  
  181. In file xlbfun.c, function xaref(), change
  182.  
  183.     array = xlgavector();
  184.  
  185. to
  186.  
  187.     array = xlgetarg();
  188.  
  189. Before the section titled "range check the index" add:
  190.  
  191.     if (stringp(array)) {   /* extension -- allow fetching chars from string*/
  192.         if (i < 0 || i >= getslength(array)-1)
  193.             xlerror("string index out of bounds",index);
  194.         return (cvchar(array->n_string[i]));
  195.     }
  196.     
  197.     if (!vectorp(array)) xlbadtype(array);  /* type must be array */
  198.  
  199. ******************************
  200. In xlcont.c, add the following declaration:
  201.  
  202. extern LVAL s_elt;
  203.  
  204.  
  205. In function placeform(), replace the fun == s_aref code with:
  206.  
  207.         xlsave1(arg1);
  208.  
  209.         arg1 = evarg(&place);   /* allow string argument */
  210.         arg2 = evmatch(FIXNUM,&place); i = getfixnum(arg2);
  211.         if (place) toomany(place);
  212.  
  213.         if (stringp(arg1)) {    /* extension for strings */
  214.             if (i < 0 || i >= getslength(arg1)-1)
  215.                 xlerror("index out of range",arg2);
  216.             if (!charp(value)) 
  217.                 xlerror("strings only contain characters",value);
  218.             arg1->n_string[i] = getchcode(value);
  219.         }
  220.         else if(vectorp(arg1)) {
  221.             if (i < 0 || i >= getsize(arg1))
  222.                 xlerror("index out of range",arg2);
  223.             setelement(arg1,(int)i,value);
  224.         }
  225.         else xlbadtype(arg1);
  226.         xlpop();
  227.  
  228. Then add the following "case":
  229.  
  230.     else if (fun == s_elt) {
  231.         xlsave1(arg1);
  232.         arg1 = evarg(&place);
  233.         arg2 = evmatch(FIXNUM,&place); i = getfixnum(arg2);
  234.         if (place) toomany(place);
  235.         if (listp(arg1)) {
  236.             for (; i > 0 && consp(arg1); --i)
  237.                 arg1 = cdr(arg1);
  238.             if((!consp(arg1)) || i < 0)
  239.                 xlerror("index out of range",arg2);
  240.             rplaca(arg1,value);
  241.         }
  242.         else if (ntype(arg1) == STRING) {
  243.             if (i < 0 || i >= getslength(arg1)-1)
  244.                 xlerror("index out of range",arg2);
  245.             if (!charp(value)) 
  246.                 xlerror("strings only contain characters",value);
  247.             arg1->n_string[i] = getchcode(value);
  248.         }
  249.         else if (ntype(arg1) == VECTOR) {
  250.             if (i < 0 || i >= getsize(arg1))
  251.                 xlerror("index out of range",arg2);
  252.             setelement(arg1,(int)i,value);
  253.         }
  254.         else xlbadtype(arg1);
  255.         xlpop();
  256.     }
  257.  
  258. ***************************
  259.  
  260. In xlstr.c, function changecase(), change
  261.  
  262.     src = xlgastr